VERSION 5.00
Begin VB.Form frmSMsg 
   Caption         =   "Send Messages via MQ"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmSMsg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Send_Q_Name
Public Q_Manager_Name
Public Requestkey As String
Public SendError As String
Public rsSendMessage As ADODB.Recordset
Public clsMq As clsMqSeries
'Fikile: 2008-04-24 commented it out
'Private Const csReg_RequestKey = "Software\Mindkey\KeyTax\QManager"
Private Const csReg_ErrorFile = "Software\Mindkey\KeyTax\ErrorFile"
Private Sub Form_Load()
    Dim mqMessage As String
    Dim Initials As String * 5
    Dim Surname As String * 30
    Dim DOB As String * 8
    Dim ClientData As String * 43
    Dim SendMessage As String * 2200
    Dim sSQL As String
    Dim SendSuc
    Dim FileUName
    
    frmSplash.Show
    DoEvents
    Me.Hide
    On Error GoTo StopProcess
'Setup Request Key
    Call SetUp_RequestKey

'Send Message
    Set rsSendMessage = New ADODB.Recordset
    
    'ssql = "select * from " message table where message ready to be send
    sSQL = " select di.interface_no, dx.xml_string "
    sSQL = sSQL & "from dir_interface_index di, dir_interface_xml dx "
    sSQL = sSQL & "where di.mq_status = '00' and "
    sSQL = sSQL & "di.interface_no = dx.interface_no "
    
    Set rsSendMessage = Get_Recordset(sSQL, "KeyTaxSQL")
    
    If Not (rsSendMessage Is Nothing) Then
        If rsSendMessage.RecordCount > 0 Then
            Do While Not rsSendMessage.EOF
                If Initialise_SendQueue = True Then
                   
                    SendSuc = Send_Message(rsSendMessage("xml_string").Value) '(rsSendMessage("Data").Value)
                    If SendSuc = 0 Then
                        Call Update_Send(rsSendMessage("interface_no").Value)
                         'MsgBox rsSendMessage("interface_no").Value
                    End If
                    
                 End If
                
                rsSendMessage.MoveNext
                frmSplash.Show
                DoEvents
            Loop
        End If
    End If
    
    DoEvents
    frmSplash.Hide
    End
    
    Exit Sub
    
StopProcess:
    FileUName = SendError & Format(Now, "YYYYMMDD") & ".txt"
    Open FileUName For Append As #1
        Print #1, Err.Number & "--" & Err.Description & " " & Now
    Close #1
    frmSplash.Hide
    End

End Sub
Sub SetUp_RequestKey()

'Setup requestkey from registry
    Requestkey = GetSettingC(csReg_RequestKey, "MQSEND_NAME")
    SendError = GetSettingC(csReg_ErrorFile, "SendErr")
    
End Sub
Sub Update_Send(Key)
    Dim sSQL As String
    
    sSQL = "update dir_interface_index "
    sSQL = sSQL & "set mq_status = '04' "
    sSQL = sSQL & "where interface_no = '" & Key & "'"
    Call Update_SQL(sSQL, "KeyTaxSQL")

End Sub
Function Initialise_SendQueue() As Boolean
     Dim MqCode
    
    Set clsMq = New clsMqSeries
    
    Initialise_SendQueue = False
    Get_Message = ""
'Use registry to setup key for different systems one system per machine

    
   Call Get_Q_M_Name(Requestkey)
   
'Open Queue Manager
    MqCode = clsMq.MQ_Op_Conn(Q_Manager_Name)
    
    If MqCode = 0 Then
'Open Receive Queue
        MqCode = clsMq.MQ_Put_Open(Requestkey)
        If MqCode = 0 Then
            Initialise_SendQueue = True
        End If
    End If
    
End Function
Function Send_Message(Data) As String


    Dim GInd As Integer
    Dim MsgID As String
    Dim CorrelID As String
    Dim DateTime As String
    Dim MsgLen As Long
    Dim sSQL As String
   
'Poll message get 100 and close connection
    
    MqCode = clsMq.MQ_Put_Msg(Requestkey, Data, CorrelID, MsgID, DateTime, MsgLen)
    
    'If MqCode = 0 Then
    '    Update send
    'End If
    
'Close Connection
    Call clsMq.MQ_Close_Conn
    Send_Message = MqCode
    
End Function

Sub Get_Q_M_Name(Requestkey As String)
    Q_Manager_Name = GetSettingC(csReg_RequestKey, "MQSEND_Q_MANAGER_NAME") '"LMD1UPAP"
    Receiving_Q_Name = GetSettingC(csReg_RequestKey, "MQSEND_RECEIVING_Q_NAME") '"LQ.LCB.LCBTOKEYTAX.01"
End Sub

